home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / LIB211.ZIP;1 / ERRLOG.PRG < prev    next >
Encoding:
Text File  |  1993-11-01  |  28.8 KB  |  724 lines
  1. PROCEDURE ErrLog
  2. *-----------------------------------------------------------------------
  3. *-- Programmer..: Peter Ripaldi (CIS: 70711,3420) (1-508-683-4987)
  4. *-- Date........: 05/24/1993
  5. *-- Notes.......: Program to produce an error log on disk that is about
  6. *--               12k long. The idea is to provide as much information 
  7. *--               as possible about the system at the time of the error.
  8. *--               On error you can print the screen to printer and/or 
  9. *--               disk if you uncomment the section(s). The error log on
  10. *--               disk is called ERROR.LOG, each error session will
  11. *--               add to the bottom of the previous error.
  12. *--               Any suggestion to adssd, or if it helps
  13. *--               let me know. Happy Erroring ?
  14. *-- Written for.: dBASE IV 1.5  
  15. *-- Rev. History: 08/23/1992 -- Original
  16. *--               04/09/1992 1.0 - none-  format from E_LOG.PRG
  17. *--               Ideas from E_LOG.PRG    author unknown
  18. *--                          ERR_TRAP.PRG author BILLG (BORBBS)
  19. *--                          SPY_CAM      author dbf magazine
  20. *--               08/23/1992 1.5 Added functions for ver 1.5
  21. *--                            Save to screen before error msg on screen 
  22. *--                            Append print screen to end of ERROR.LOG 
  23. *--                            file. Send network msg, idea from 
  24. *--                            Bob(IVYBURT)
  25. *--              11/13/1992 -- modified seriously by Ken Mayer, allowing
  26. *--                            programmer calls to PRINTSCR and SCREEN, 
  27. *--                            as well as network, by passing parms to 
  28. *--                            the routine. Cleaned up the programming 
  29. *--                            a lot. Removed the need for as many 
  30. *--                            memvars.
  31. *--              05/24/1993 -- Updated by Peter Stevens (HMRS)
  32. *--                           (CIS 100114,301)
  33. *--                            Resolved small problem with MESSAGE()
  34. *--                            Non-RunTime commands are *rd out 
  35. *--               11/01/1993 -- Uppdated by Ken Mayer for 3-D version
  36. *--                             of SURROUND() routine.
  37. *-- Calls.......: PRINTSCR.BIN  Prints screen to printer if parameter is
  38. *--                             set
  39. *--               SCREEN.BIN    Prints screen to disk if parameter is 
  40. *--                             set
  41. *--               SURROUND()    Function below
  42. *--               CENTER        Procedure below
  43. *-- Called by...: Any
  44. *-- Usage.......: on error do ErrorLog with error(),message(),lineno(),;
  45. *--                                         program(),alias(),memory();
  46. *--                                         [,<lPrntScrn>[,<lScrn2Disk>;
  47. *--                                         [,<cNetId>]]]
  48. *-- Example.....: on error do errorlog with error(),message(),lineno(),;
  49. *--                                    program(),alias(),memory(),.t.,;
  50. *--                                    .t.,"MAYER"
  51. *-- Returns.....: None
  52. *-- Parameters..: error()    = dBASE Function
  53. *--               message()  = dBASE Function
  54. *--               lineno()   = dBASE Function
  55. *--               program()  = dBASE Function
  56. *--               alias()    = dBASE Function
  57. *--               memory()   = dBASE Function
  58. *--               lPrntScrn  = logical -- print the screen?
  59. *--               lScrn2Disk = logical -- print the screen to disk?
  60. *--               cNetId     = Network ID for user on a NOVELL NETWORK
  61. *--                            to send a Network message to letting them
  62. *--                            know about this error.
  63. *-----------------------------------------------------------------------
  64.    *-- Try to bring in as much of system before loading anything else
  65.    PARAMETER nError,cErrTxt,nLineNo,cProgram,cAlias,nMemory,lPrntScrn,;
  66.              lScrn2Disk,cNetId
  67.  
  68.    *-- talk off so answers to IIF() dont go in ERROR.LOG file
  69.    cTalk = set("TALK")
  70.    set talk off
  71.  
  72.    *-- deal with optional parameters
  73.    m->nParms = pCount()  && how many parameters were passed?
  74.    if m->nParms < 9      && no Net Id
  75.       m->cNetId = ""
  76.    endif
  77.    if m->nParms < 8      && no lScrn2Disk parm
  78.       m->lScrn2Disk = .f.
  79.    endif
  80.    if m->nParms < 7      && no Print Screen parm
  81.       m->lPrntScrn = .f.
  82.    endif
  83.    
  84.    *-- Get copy of screen so we can restore it after were done
  85.    save screen to sError
  86.    activate screen
  87.  
  88.    *-- set up disk file ERROR.LOG
  89.    set alternate to
  90.  
  91.    *-- Let user know SOMETHING'S happening
  92.    x=surround(12,"rg+/r","An Error Has Occured -- Writing Log")
  93.    x=surround(18,"rg+/rg",""+trim(cErrTxt)+" ")   
  94.    *-- Pause a while so user can see what the error is  
  95.    i = inkey(2) 
  96.  
  97.    *-- If already there add to it, in case of more errors next time 
  98.    *-- runs prg
  99.    if file("ERROR.LOG")
  100.       set alternate to error.log additive
  101.    else
  102.    *-- If not there make one
  103.       set alternate to error.log
  104.    endif && file("ERROR.LOG")
  105.  
  106.    *-- Turn on ERROR.LOG file
  107.    set alternate on
  108.  
  109.    *-- Turn screen off
  110.    set console off
  111.  
  112.    *-- set date to 19xx format
  113.    set century on
  114.  
  115.    *-- Begin error logging information to disk
  116.    *
  117.    * Set up heading
  118.  ? "==================================================================="
  119.  ? "=====               Begin Errors Found                        ====="
  120.  ? "====="            
  121.  ?? SPACE(6)+CDOW(DATE())+SPACE(10)+MDY(DATE())+SPACE(9)+(TIME())
  122.  ?? "====="
  123.  ? "==================================================================="
  124.  ?
  125.  ? " Error / Program Information"
  126.  ? "------------------------------"
  127.  ? "    Error #      : " + LTRIM(STR(m->nError)) +"  "+trim(m->cErrTxt)
  128.  ? "    In Program   : " + m->cProgram
  129.  ? "    On Line #    : " + LTRIM(STR(m->nLineNo))
  130.  ? "    Catalog Name : " + LTRIM(CATALOG())
  131.  ?
  132.  ?
  133.  
  134.  ? " System Information"
  135.  ? "------------------------------"
  136.  ? "    Memory          : " + LTRIM(STR(m->nMemory))
  137.  ? "    Diskspace       : " + LTRIM(STR(DISKSPACE()))
  138.  ? "    Path            : " + GETENV("path")
  139.  ? "    Prompt          : " + GETENV("prompt")
  140.  ? "    ComSpec         : " + GETENV("comspec")
  141.  ? "    Operating Sys   : " + LTRIM(OS())
  142.  ? "    Dbase Version   : " + LTRIM(VERSION(0))
  143.  ? "    Dbase Path      : " + LTRIM(HOME())
  144.  ? "    Compile Error   : " + LTRIM(STR(CERROR()))
  145.  ? "    Color system    : " + iif(iscolor(),"Yes","No") 
  146.  ?
  147.  ?
  148.  
  149.  ? "  Database File Information "
  150.  ? "------------------------------"
  151.  ? "    DBF File        : " + DBF()
  152.  ? "    Alias Name      : " + m->cAlias
  153.  ? "    Work area       : " + LTRIM(STR(SELECT()))
  154.  ? "    Order           : " + ORDER()
  155.  ? "    Record #        : " + LTRIM(STR(RECNO()))
  156.  ? "    Field count     : " + LTRIM(STR(FLDCOUNT()))
  157.  ? "    Tag name        : " + LTRIM(TAG())
  158.  ? "    Tag count       : " + LTRIM(STR(TAGCOUNT()))
  159.  ? "    Tag number      : " + LTRIM(STR(TAGNO()))
  160.  ? "    MDX file        : " + LTRIM(MDX())
  161.  ? "    NDX file        : " + LTRIM(NDX())
  162.  ? "    Descending index: " + iif(descending(),"Yes","No") 
  163.  ?
  164.  ? "    For condition of mdx tag  : " + LTRIM(FOR())
  165.  ? "    Expression of mdx/ndx tag : " + LTRIM(KEY())
  166.  ? "    Unique Index              : " + iif(unique(),"Yes","No") 
  167.  ? "    Deleted                   : " + iif(deleted(),"Yes","No") 
  168.  ? "    Record Count              : " + LTRIM(STR(RECCOUNT()))
  169.  ?
  170.  *-- record size may not be right add 35 for header if wanted
  171.  ? "    Record Size     : " + LTRIM(STR(RECSIZE()))
  172.  ? "    Last Update     : " + DTOC(LUPDATE())
  173.  ? "    Last Seek Found : " + iif(found(),"Yes","No") 
  174.  ? "    End Of File     : " + iif(eof(),"Yes","No") 
  175.  ? "    Begin Of File   : " + iif(bof(),"Yes","No") 
  176.  ?
  177.  ?
  178.  
  179.  ? "  Program Information "
  180.  ? "------------------------------"
  181.  ? "    Number of parameters called : " + LTRIM(STR(PCOUNT()))
  182.  ?
  183.  ?
  184.  
  185.  ? " File / User / Network  Information"
  186.  ? "------------------------------"
  187.  ? "    On Network             : " + iif(network(),"Yes","No") 
  188.  ? "    DBF in state of change : " + iif(ismarked(),"Yes","No") 
  189.  ? "    User Access Level      : " + LTRIM(STR(ACCESS()))
  190.  ? "    Log in User Name       : " + USER()
  191.  ? "    Name of current User   : " + ID()
  192.  ? "    Changed by others      : " + iif(change(),"Yes","No") 
  193.  ? "    Completed Transaction  : " + iif(completed(),"Yes","No") 
  194.  ? "    Rollback  Successful   : " + iif(rollback(),"Yes","No") 
  195.  ? "    Record Lock            : " + iif(rlock(),"Yes","No") 
  196.  ? "    File Lock              : " + iif(flock(),"Yes","No") 
  197.  ? 
  198.  ?
  199.  ? " List of Users  "
  200.  ? "--------------------------------"
  201.  list users
  202.  ?
  203.  ?
  204.  ? " Screen Information "
  205.  ? "------------------------------"
  206.  ? "    Window        : " + WINDOW()
  207.  ? "    Pad           : " + PAD()
  208.  ? "    Popup         : " + POPUP()
  209.  ? "    Bar #         : " + LTRIM(STR(BAR()))
  210.  ? "    Prompt        : " + PROMPT()
  211.  ? "    Menu          : " + MENU()
  212.  ? "    Cursor Row    : " + LTRIM(STR(ROW()))
  213.  ? "    Cursor Column : " + LTRIM(STR(COL()))
  214.  ?
  215.  ?
  216.  
  217.  ? " Key Stroke Information "
  218.  ? "------------------------------"
  219.  ? "    Varread       : " + VARREAD()
  220.  ? "    Inkey         : " + LTRIM(STR(INKEY()))
  221.  ? "    Lastkey       : " + LTRIM(STR(LASTKEY()))
  222.  ? "    Readkey       : " + LTRIM(STR(READKEY()))
  223.  ?
  224.  
  225.  ? " Printer Information "
  226.  ? "------------------------------"
  227.  ? "    Print Status     : " + iif(printstatus(),"Yes","No") 
  228.  ? "    Print Column     : " + LTRIM(STR(PCOL()))
  229.  ? "    Print Row        : " + LTRIM(STR(PROW()))
  230.  ?
  231.  ?
  232.  
  233.  * List  Status, Memory, History .....
  234.  ? " Status Listing "
  235.  ? "----------------------------------------------"
  236.  ?
  237.  ?
  238.  list status
  239.  
  240.  ? " Memory Listing "
  241.  ? "----------------------------------------------"
  242.  ?
  243.  ?
  244.  list memory
  245.  ?
  246.  ?
  247.  
  248. * ? " History Listing "
  249. * ? "------------------------------------------------"
  250. * list history
  251. * ?
  252. * ?
  253.  * End of errors for this time
  254.  ? "==================================================================="
  255.  ? "=====              End of Errors Found                        ====="
  256.  ? "====="
  257.  ?? space(6)+cdow(date())+space(10)+mdy(date())+space(9)+(time())
  258.  ?? "====="
  259.  ? "==================================================================="
  260.  * spaces to seperate error log for next time error happens
  261.  ?
  262.  ?
  263.  ?
  264.  ?
  265.    *-- All done with saving file close up error file
  266.    set alternate off
  267.    set alternate to
  268.    set console on
  269.    set century off
  270.  
  271.    *--------------------------------------------------------------------
  272.    *-- optional stuff here
  273.    *--------------------------------------------------------------------
  274.    restore screen from sError  && remove message to user ...
  275.    if m->lPrntScrn
  276.       *-- Print Screen First, uses printscr.bin
  277.       load printscr
  278.       call printscr
  279.       release module printscr
  280.    endif
  281.  
  282.    *--------------------------------------------------------------------
  283.    *-- Print screen to disk?
  284.    *--------------------------------------------------------------------
  285.    * Print screen to disk file called Erscreen.txt,  uses screen.bin 
  286.    * The "a" option will append to text file
  287.    if m->lScrn2Disk
  288.       load screen
  289.       call screen with "a", "Erscreen.txt"
  290.       release module screen
  291.       eject   && form feed to clear out printer ...
  292.  
  293.      *- Add screen to end of ERROR.LOG file
  294.      set alternate to error.log additive
  295.  
  296.      *-- Turn screen off
  297.      set console off
  298.  
  299.      *-- turn on ERROR.LOG file for heading
  300.      set alternate on
  301.      ? "Screen Dump of above error"
  302.      ? "-----------------------------------------------"
  303.      ?
  304.      *-- All done with heading close up ERROR.LOG file
  305.      set alternate off
  306.      set alternate to
  307.  
  308.      *-- Now add screen to end of ERROR.LOG file
  309.      load screen
  310.      call screen with "a", "ERROR.LOG"
  311.      release module screen
  312.      *-- all done 
  313.      set console on
  314.    endif  && lScrn2File
  315.  
  316.   *---------------------------------------------------------------------
  317.   *-- After all that, let's let the user know what happened
  318.   *---------------------------------------------------------------------
  319.   * For real fun use one of KenMayer's "Death March" Songs (MISC.PRG)
  320.   * Alert user for heart attack, Give a tone
  321.   set bell to 500,5
  322.   ?? chr(7)
  323.   set bell to 400,4
  324.   ?? chr(7)
  325.   *set bell to 500,5
  326.   *?? chr(7)
  327.   *set bell to 400,5
  328.   *?? chr(7)
  329.   *set bell to 500,5
  330.   *?? chr(7)
  331.   set bell to
  332.  
  333.    *-- Give user message, on error window
  334.    define window wError from 0,0 to 24,79 double
  335.    activate window wError
  336.    *-- sample message inspired by movie China Syndrome
  337.    x=surround(4,"rg+/rg"," ** E R R O R  L O G **  ")
  338.    do center with  8,80,"",;
  339.                        "The following unscheduled event has happened."
  340.    do center with 10,80,""," "+trim(m->cErrTxt)+" "
  341.    do center with 12,80,"","The information has been stored to disk."
  342.    do center with 14,80,"","Notify Programmer Immediately!"
  343.    do center with 16,80,"",;
  344.                          "You are being returned to the dot prompt, or"
  345.    do center with 18,80,"","(if using RUNTIME) being dropped to DOS."
  346.    do center with 20,80,"","Press a key to continue ..."
  347.    *-- Wait until user sees message
  348.    x=inkey(0) 
  349.  
  350.    *--------------------------------------------------------------------
  351.    *-- Network message to programmer?
  352.    *--------------------------------------------------------------------
  353.    if .not. isblank(m->cNetId)
  354.       * From Bob (IVYBURT)
  355.       * If you're on a network, option to send a message to network 
  356.       * manager notify of mentally deranged program.
  357.  
  358.      if network()=.t.
  359.         !SEND &cNetId. " Help -- Program Crashed!" 
  360.      endif  && network()
  361.    endif  && .not. isblank(m->cNetId)
  362.  
  363.    *--------------------------------------------------------------------
  364.    *-- done with window, shut-down
  365.    *--------------------------------------------------------------------
  366.    deactivate window wError
  367.    release window wError
  368.    clear all
  369.    release all
  370. clear
  371. Cancel         && rather than returning user to where they were
  372.  
  373. *-----------------------------------------------------------------------
  374. *-- Extra Functions called from above ...
  375. *-----------------------------------------------------------------------
  376.  
  377. PROCEDURE Center
  378. *-----------------------------------------------------------------------
  379. *-- Programmer..: Miriam Liskin
  380. *-- Date........: 05/24/1991
  381. *-- Notes.......: Centers text on the screen with @says
  382. *-- Written for.: dBASE IV, 1.1
  383. *-- Rev. History: This and all other procedures/functions listed in this
  384. *--               file attributed to Miriam Liskin came from "Liskin's
  385. *--               Programming dBASE IV Book". Very good, worth the money
  386. *-- Calls.......: None
  387. *-- Called by...: Any
  388. *-- Usage.......: do center with <nLine>,<nWidth>,"<cColor>","<cText>"
  389. *-- Example.....: do center with 5,65,"RG+/GB",;
  390. *--                           "WARNING! This will blow up!"
  391. *--                  Note that the color field may be blank: ""
  392. *-- Returns.....: None
  393. *-- Parameters..: nLine  = Line or Row for @/Say
  394. *--               nWidth = Width of screen
  395. *--               cColor = Colors to be used ("Forg/Back") 
  396. *--                        (may be nul "", in order to use the default
  397. *--                         colors of window/screen)
  398. *--               cText  = Message to center on screen
  399. *-----------------------------------------------------------------------
  400.    
  401.    parameters nLine,nWidth,cColor,cText
  402.    private nCol
  403.    
  404.    m->nCol = (m->nWidth - len(m->cText)) /2
  405.    @m->nLine,m->nCol say cText color &cColor.
  406.    
  407. RETURN
  408. *-- EoP: Center
  409.  
  410. FUNCTION Surround
  411. *-----------------------------------------------------------------------
  412. *-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
  413. *-- Date........: 06/28/1993
  414. *-- Notes.......: Displays a message surrounded by a box anywhere on 
  415. *--               the screen -- this version centers automatically on
  416. *--               the screen and gives a 3-D border ...
  417. *--               This is based on the original routine by Miriam Liskin
  418. *-- Written for.: dBASE IV, 1.5
  419. *-- Rev. History: 06/09/1993 -- Original
  420. *--               06/28/1993 -- Fixed minor problem -- if displaying
  421. *--                             over a textured background, the borders
  422. *--                             can look a bit odd. Added a CLEAR ...
  423. *-- Calls.......: SHADOW               Procedure in PROC.PRG
  424. *--               Bord3D               Procedure in PROC.PRG
  425. *-- Called by...: Any
  426. *-- Usage.......: Surround(<nLine>,"<cColor>","<cText>"[,<nStyle>])
  427. *-- Example.....: cDummy = Surround(5,12,"RG+/GB",;
  428. *--                        "Processing ... Do not Touch!",1)
  429. *-- Returns.....: Nul/""
  430. *-- Parameters..: nLine   = Line to display "surrounded" message at
  431. *--                         if nLine = 0, we will center on the screen
  432. *--                         vertically, as well as horizontally.
  433. *--               cColor  = Color variable/colors (Default to grey)
  434. *--               cText   = Text to be displayed inside box
  435. *--               nStyle  = Style of border 1 = Double - Raised(Default)
  436. *--                                         2 = Double - Recessed
  437. *--                                         3 = Single - Raised
  438. *--                                         4 = Double - Recessed
  439. *--                          NOTE: This is OPTIONAL
  440. *-----------------------------------------------------------------------
  441.    
  442.    parameters nLine,cColor,cText,nStyle
  443.    private nStyle, cColor, cText2, nTextStart, nTop, nLeft, nBottom,;
  444.           nRight, nLine
  445.    
  446.    *-- deal with defaults
  447.    if pCount() < 4 .or. (m->nStyle < 1 .or. m->nStyle > 4) 
  448.       m->nStyle = 1
  449.    endif
  450.    if isblank(m->cColor)
  451.       m->cColor = "n/w"
  452.    endif
  453.    
  454.    *-- deal with nLine being equal to 0 when user passes this (this will
  455.    *-- cause the routine to center on the screen ... no matter how the
  456.    *-- screen is set).
  457.    if m->nLine = 0
  458.       m->cScreen = set("DISPLAY")
  459.       if m->cScreen = "MONO"
  460.          m->nScreen = 24
  461.       else
  462.          m->nScreen = val(right(m->cScreen,2)) - 1  && EGA25 = 0 to 24
  463.       endif
  464.       m->nLine = int(m->nScreen/2)  && halfway ...
  465.    endif
  466.    
  467.    m->cText2 = " "+trim(m->cText)+" "    && add spaces to left and right
  468.    m->nTextStart = (81-len(trim(m->cText2)))/2  && centered text 
  469.    activate screen
  470.    m->nTop    = m->nLine - iif(m->nStyle < 3,2,1)      && up 2 or 1 ...
  471.    m->nLeft   = m->nTextStart - iif(m->nStyle < 3,3,2) && back up 3 
  472.    m->nBottom = m->nLine + iif(m->nStyle < 3,2,1)      && bottom row
  473.    m->nRight  = (81-m->nTextStart) + iif(m->nStyle < 3,3,2) && right 
  474.    
  475.    *-- draw shadow
  476.    do shadow with m->nTop,m->nLeft,m->nBottom,m->nRight
  477.    
  478.    *-- fill in box
  479.    @m->nTop,m->nLeft clear to m->nBottom,m->nRight 
  480.    @m->nTop,m->nLeft fill  to m->nBottom,m->nRight color &cColor.
  481.    
  482.    *-- place border on top of it
  483.    do Bord3D with m->nTop,m->nLeft,m->nBottom,m->nRight,m->cColor,;
  484.                   m->nStyle
  485.    
  486.    *-- finally, let's display the text ...
  487.    @m->nLine, m->nTextStart say m->cText2 color &cColor.  
  488.    
  489. RETURN "" 
  490. *-- EoF: Surround()
  491.  
  492. PROCEDURE Bord3D
  493. *-----------------------------------------------------------------------
  494. *-- Programmer..: Kenneth J. Mayer (CIS: 71333,1030)
  495. *-- Date........: 06/02/1993
  496. *-- Notes.......: This is an attempt to combine the 3-D border routines
  497. *--               (BORD3D through BORD3D4) -- allowing a selection 
  498. *--               between four border styles ... 
  499. *-- Written for.: dBASE IV, 1.5 or later
  500. *-- Rev. History: 06/02/1993
  501. *-- Calls.......: None
  502. *-- Called by...: Any 
  503. *-- Usage.......: do Bord3D with <nULR>,<nULC>,<nBRR>,<nBRC>,<cColor>,;
  504. *--                              <nStyle>
  505. *-- Example.....: do Bord3D with 0,0,15,60,2
  506. *-- Returns.....: None
  507. *-- Parameters..: nULR   = Upper Left Row (Starting Coordinates)
  508. *--               nULC   = Upper Left Column
  509. *--               nBRR   = Bottom Right Row (Ending Coordinates)
  510. *--               nBRC   = Bottom Right Column
  511. *--               cColor = Colors of Window/Box ...
  512. *--               nStyle = Border style:
  513. *--                        1 = Double, Raised
  514. *--                        2 = Double, Recessed
  515. *--                        3 = Single, Raised
  516. *--                        4 = Single, Recessed
  517. *-----------------------------------------------------------------------
  518.  
  519.    parameters nULR, nULC, nBRR, nBRC, cColor, nStyle
  520.    private cBorder,cBackColor,cHighColor,cShadColor
  521.    
  522.    *-- deal with border ...
  523.    m->cBorder = set("BORDER")
  524.    set border to single
  525.    
  526.    *-- figure out colors
  527.    m->cBackColor = backcolor(m->cColor)
  528.    m->cHighColor = "W+/"+m->cBackColor
  529.    m->cShadColor = "N/"+m->cBackColor
  530.    
  531.    if m->nStyle < 1 .or. m->nStyle > 4  && if not 1 through 4 ...
  532.       m->nStyle = 1
  533.    endif
  534.    
  535.    do case
  536.       case m->nStyle = 1
  537.       
  538.          *-- Raised DOUBLE Border
  539.          *-- Outside of "border"
  540.          @m->nULR,m->nULC to m->nULR,m->nBRC   color &cHighColor. 
  541.          @m->nULR,m->nULC to m->nBRR,m->nULC   color &cHighColor.   
  542.          @m->nULR,m->nULC say chr(218)         color &cHighColor. 
  543.          @m->nBRR,m->nULC say chr(192)         color &cHighColor. 
  544.          @m->nULR,m->nBRC to m->nBRR,m->nBRC   color &cShadColor. 
  545.          @m->nBRR,m->nULC+1 to m->nBRR,m->nBRC color &cShadColor. 
  546.          @m->nULR,m->nBRC say chr(191)         color &cShadColor. 
  547.          @m->nBRR,m->nBRC say chr(217)         color &cShadColor. 
  548.       
  549.          *-- inside of "border"
  550.          @m->nULR+1,m->nULC+2 to m->nULR+1,m->nBRC-2 color &cShadColor. 
  551.          @m->nULR+1,m->nULC+2 to m->nBRR-1,m->nULC+2 color &cShadColor.  
  552.          @m->nULR+1,m->nULC+2 say chr(218)           color &cShadColor. 
  553.          @m->nBRR-1,m->nULC+2 say chr(192)           color &cShadColor. 
  554.          @m->nULR+1,m->nBRC-2 to m->nBRR-1,m->nBRC-2 color &cHighColor. 
  555.          @m->nBRR-1,m->nULC+3 to m->nBRR-1,m->nBRC-2 color &cHighColor. 
  556.          @m->nULR+1,m->nBRC-2 say chr(191)           color &cHighColor. 
  557.          @m->nBRR-1,m->nBRC-2 say chr(217)           color &cHighColor. 
  558.    
  559.       case m->nStyle = 2
  560.          
  561.          *-- Recessed DOUBLE Border
  562.          *-- Outside of "border"
  563.          @m->nULR,m->nULC to m->nULR,m->nBRC   color &cShadColor. 
  564.          @m->nULR,m->nULC to m->nBRR,m->nULC   color &cShadColor.   
  565.          @m->nULR,m->nULC say chr(218)         color &cShadColor. 
  566.          @m->nBRR,m->nULC say chr(192)         color &cShadColor. 
  567.          @m->nULR,m->nBRC to m->nBRR,m->nBRC   color &cHighColor. 
  568.          @m->nBRR,m->nULC+1 to m->nBRR,m->nBRC color &cHighColor. 
  569.          @m->nULR,m->nBRC say chr(191)         color &cHighColor. 
  570.          @m->nBRR,m->nBRC say chr(217)         color &cHighColor. 
  571.       
  572.          *-- inside of "border"
  573.          @m->nULR+1,m->nULC+2 to m->nULR+1,m->nBRC-2 color &cHighColor.
  574.          @m->nULR+1,m->nULC+2 to m->nBRR-1,m->nULC+2 color &cHighColor.   
  575.          @m->nULR+1,m->nULC+2 say chr(218)           color &cHighColor. 
  576.          @m->nBRR-1,m->nULC+2 say chr(192)           color &cHighColor. 
  577.          @m->nULR+1,m->nBRC-2 to m->nBRR-1,m->nBRC-2 color &cShadColor. 
  578.          @m->nBRR-1,m->nULC+3 to m->nBRR-1,m->nBRC-2 color &cShadColor. 
  579.          @m->nULR+1,m->nBRC-2 say chr(191)           color &cShadColor. 
  580.          @m->nBRR-1,m->nBRC-2 say chr(217)           color &cShadColor. 
  581.    
  582.       case m->nStyle = 3
  583.          
  584.          *-- Raised SINGLE Border
  585.          @m->nULR,m->nULC to m->nULR,m->nBRC color &cHighColor. 
  586.          @m->nULR,m->nULC to m->nBRR,m->nULC color &cHighColor. 
  587.          @m->nULR,m->nBRC to m->nBRR,m->nBRC color &cShadColor. 
  588.          @m->nBRR,m->nULC to m->nBRR,m->nBRC color &cShadColor. 
  589.          @m->nULR,m->nULC say chr(218)       color &cHighColor. 
  590.          @m->nBRR,m->nULC say chr(192)       color &cHighColor. 
  591.          @m->nULR,m->nBRC say chr(191)       color &cShadColor. 
  592.          @m->nBRR,m->nBRC say chr(217)       color &cShadColor. 
  593.          
  594.       case m->nStyle = 4
  595.    
  596.          *-- Recessed SINGLE Border
  597.          @m->nULR,m->nULC to m->nULR,m->nBRC color &cShadColor. 
  598.          @m->nULR,m->nULC to m->nBRR,m->nULC color &cShadColor.   
  599.          @m->nULR,m->nBRC to m->nBRR,m->nBRC color &cHighColor. 
  600.          @m->nBRR,m->nULC to m->nBRR,m->nBRC color &cHighColor. 
  601.          @m->nULR,m->nULC say chr(218) color       &cShadColor. 
  602.          @m->nBRR,m->nULC say chr(192) color       &cShadColor. 
  603.          @m->nULR,m->nBRC say chr(191) color       &cHighColor. 
  604.          @m->nBRR,m->nBRC say chr(217) color       &cHighColor. 
  605.    
  606.    endcase
  607.    
  608.    *-- reset border
  609.    set border to &cBorder.
  610.    
  611. RETURN
  612. *-- EoP: Bord3D
  613.  
  614. PROCEDURE Shadow
  615. *-----------------------------------------------------------------------
  616. *-- Programmer..: Ashton-Tate
  617. *-- Date........: 06/02/1993
  618. *-- Notes.......: Creates a shadow for a window (taken from the dBASE IV
  619. *--               picklist functions)
  620. *-- Written for.: dBASE IV, 1.1
  621. *-- Rev. History: 05/23/1991 - original procedure.
  622. *--               12/14/1991 - Modified by Jim Magnant (TXAGGIE) - to 
  623. *--                 check for columns exceeding 79, and temporarily 
  624. *--                 change last col. value (so routine doesn't "blow 
  625. *--                 up").
  626. *--               01/27/1992 -- Modifiedy by Ken Mayer to check for 
  627. *--                 bottom of screen, based on what Jim did above. No 
  628. *--                 further than 23.
  629. *--               06/02/1993 -- Modified to handle screens larger than 
  630. *--                 24 lines. (KJM)
  631. *-- Calls.......: None
  632. *-- Called by...: Too many to list ...
  633. *-- Usage.......: do shadow with <nULRow>,<nULCol>,<nBRRow>,<nBRCol>
  634. *-- Example.....: save screen to sMain
  635. *--               activate screen
  636. *--               define window wError from 5,15 to 15,65 double color;
  637. *--                    rg+/r,rg+/r,rg+/r
  638. *--               do shadow with 5,15,15,65
  639. *--               activate window WError
  640. *--                && perform actions in window
  641. *--               release window WError
  642. *--               restore screen from sMain
  643. *--               release screen sMain
  644. *-- Returns.....: None
  645. *-- Parameters..: nULRow = Upper Left Row position
  646. *--               nULCol = Upper Left Column position (x,y)
  647. *--               nBRRow = Bottom Right Row position
  648. *--               nBRCol = Bottom Right Column position (x2,y2)
  649. *-----------------------------------------------------------------------
  650.  
  651.    parameters nULRow,nULCol,nBRRow,nBRCOL
  652.    private nTempRow,nTempCol,nIncRow,nIncCol,cScreen,nScreen
  653.  
  654.    *-- if screen is larger than 24 lines (EGA43, EGA50 ...)
  655.    m->cScreen = set("DISPLAY")
  656.    if m->cScreen = "MONO"
  657.       m->nScreen = 23
  658.    else
  659.       m->nScreen = val(right(m->cScreen,2))-2
  660.    endif
  661.       
  662.    m->nTempRow = iif(m->nBRRow+1>m->nScreen,m->nScreen,m->nBRRow+1)
  663.    m->nTempCol = iif(m->nBRCol+2>79,79,m->nBRCol+2)
  664.    m->nIncRow = 1
  665.    m->nIncCol = (m->nBRCol-m->nULCol) / (m->nBRRow-m->nULRow)
  666.    do while m->nTempRow <> m->nULRow .or. m->nTempCol <> m->nULCol+2
  667.       m->nRightCol = m->nBRCol
  668.       m->nBRCol = iif(m->nBRCol + 2 > 79,77,m->nBRCol)
  669.       m->nBotRow = m->nBRRow
  670.       m->nBRRow = iif(m->nBRRow + 1 > m->nScreen,m->nScreen-1,m->nBRRow)
  671.       @ m->nTempRow,m->nTempCol fill to m->nBRRow+1,m->nBRCol+2 ;
  672.           color n+/n
  673.       m->nBRCol = m->nRightCol
  674.       m->nBRRow = m->nBotRow
  675.       m->nTempRow = iif(m->nTempRow<>m->nULRow,m->nTempRow -m->nIncRow,;
  676.                         m->nTempRow)
  677.       m->nTempCol = iif(m->nTempCol<>m->nULCol+2,m->nTempCol - ;
  678.                         m->nIncCol,m->nTempCol)
  679.       m->nTempCol = iif(m->nTempCol<m->nULCol+2,m->nULCol+2,m->nTempCol)
  680.    enddo
  681.    
  682. RETURN
  683. *-- EoP: Shadow
  684.  
  685. FUNCTION BackColor
  686. *-----------------------------------------------------------------------
  687. *-- Programmer..: Jay Parsons       CIS 70160,340
  688. *-- Date........: 02/24/1993
  689. *-- Notes       : Returns background part of color string.
  690. *-- Written for.: dBASE IV, Version 1.5.
  691. *-- Rev. History: 02/04/1993 -- Original Release
  692. *-- Calls       : None
  693. *-- Called by...: Any
  694. *-- Usage.......: BackColor( <cColor> )
  695. *-- Example.....: ? BackColor( "N/BG" )
  696. *-- Parameters..: cColor    -   String holding color foreground and 
  697. *--                             background
  698. *-- Returns.....: Character, string with background portion of the 
  699. *--               color. Returns empty string if no such portion.
  700. *-----------------------------------------------------------------------
  701.  
  702.    parameters cColor
  703.    private m->cRet
  704.  
  705.    m->cRet = upper( trim( ltrim( m->cColor ) ) )
  706.    if "/" $ m->cRet
  707.       m->cRet = substr( m->cRet, at( "/", m->cRet ) + 1 )
  708.       if "*" $ m->cRet
  709.          m->cRet = stuff( m->cRet, at( "*", m->cRet ), 1, "" )
  710.       endif
  711.       if "+" $ m->cRet 
  712.          m->cRet = stuff( m->cRet, at( "+", m->cRet ), 1, "" )
  713.       endif
  714.    else
  715.       m->cRet = ""
  716.    endif
  717.  
  718. RETURN upper( ltrim( trim( m->cRet ) ) )
  719. *-- EoF: BackColor()
  720.  
  721. *-----------------------------------------------------------------------
  722. *-- End of Program: ERRLOG.PRG
  723. *-----------------------------------------------------------------------
  724.